home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Mac100% 1998 November
/
MAC100-1998-11.ISO.7z
/
MAC100-1998-11.ISO
/
オンラインソフト定点観測
/
ユーティリティ
/
Mops 3.2.sea
/
Mops 3.2
/
Mops source
/
Asm Source
/
ic2
< prev
next >
Wrap
Text File
|
1993-07-25
|
14KB
|
841 lines
¥ IC2 - Build the actual codes and return lengths of the instructions.
¥ 9/85 RW Split off from instClasses
¥ 03/06/86 GDC fixed MOVEM (type 20)
¥ Aug 86 mrh fixed several more bugs in MOVEM
¥ Jul 87 mrh added PUSH, POP
¥ Jun 92 mrh fixed move to CCR
¥ TYPE14 - MOVE instruction
¥ the bad one. and I do mean Bad ( Leroy Brown bad )
: MOVESIZE ¥ ( n -- n' )
SELECT{ 0 is{ 1 }end
1 is{ 3 }end
2 is{ 2 }end
DEFAULT{
}SELECT
12 << ;
:CLASS type14 super( machinst )
:M BUILD: { ¥ work flag size -- }
op1 getOp
op2 getOp
true -> flag
mode: op1 sr-type =
IF false -> flag
sr>-code -> work
ea: op2 work or w,
THEN
mode: op2 sr-type =
IF false -> flag
>sr-code -> work
ea: op1 work or w,
THEN
mode: op1 ccr-type =
IF false -> flag
ccr>-code -> work
ea: op2 work or w,
THEN
mode: op2 ccr-type =
IF false -> flag
>ccr-code -> work
ea: op1 work or w,
THEN
mode: op2 usp-type =
IF false -> flag
usp-code -> work
reg: op1 work or w,
THEN
mode: op1 usp-type =
IF false -> flag
usp-code -> work
reg: op2 work or -> work
8 ++> work
work w,
THEN
flag
IF get: bytecode
opFmt moveSize or
reg: op2 9 << mode: op2 7 min 6 << or or
ea: op1 or
w,
THEN
op1 compIdxMode
op2 compIdxMode
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
mode: op1 usp-type = mode: op2 1 = not and
mode: op2 usp-type = mode: op1 1 = not and or
IF 208 asmError THEN
op1 modesize op2 modesize + 1+
;M
;CLASS
¥ TYPE15 - MOVEQ. e.g. MOVEQ
:CLASS type15 super( machinst )
:M BUILD: { ¥ work -- }
op1 getOp
op2 getOp
get: bytecode
value: op1 249 byteChk or
reg: op2 9 << or w,
;M
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1
;M
;CLASS
¥ TYPE16 - TRAP, e.g. TRAP #12
:CLASS type16 super( machinst )
:M BUILD:
op1 getOp
get: bytecode
value: op1 15 min 0 max or w,
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
1
;M
;CLASS
¥ TYPE18 - MOVEP
:CLASS type18 super( machinst )
:M LENGTH: ( -- len )
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
1
op1 modesize +
op2 modesize +
;M
:M BUILD: { ¥ work mode dreg areg aOp -- }
op1 getOp
op2 getOp
mode: op1 0=
IF
opFmt 2 =
IF
7 -> mode
ELSE
6 -> mode
THEN
reg: op1 -> dreg
reg: op2 -> areg
op2 -> aOp
ELSE
opFmt 2 =
IF
5 -> mode
ELSE
4 -> mode
THEN
reg: op2 -> dreg
reg: op1 -> areg
op1 -> aOp
THEN
get: bytecode -> work
dreg 9 << work or -> work
mode 6 << work or -> work
areg work or -> work
work w,
aOp compidxmode
;M
;CLASS
¥ TYPE19 - DBcc, etc.
:CLASS type19 super( machinst )
:M BUILD:
op1 getOp
op2 getOp
get: bytecode
reg: op1 or w,
op2 abs: operand here - 248 wordChk w,
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
2
;M
;CLASS
¥ TYPE20 - MOVEM
:CLASS type20 super( machinst )
:M BUILD: { ¥ opDesc regMask drFlag -- }
msg" build moveMsg"
op1 getOp
mode: op1 0= mode: op1 1 = or
IF ¥ register list in operand 1
msg" exec IF"
op1 false buildRegMask -> regMask
¥ make register mask. Flag always 1.
op2 getOp
0 -> drFlag
ea: op2
ELSE ¥ register list in operand 2
msg" exec ELSE"
1 -> drFlag
nextToken drop
op2 getOp
op2 false buildRegMask -> regMask
ea: op1
THEN
( ea in stack ) get: bytecode or
drFlag 10 << or
opFmt 1 max 1- 6 << or w,
regMask
mode: op2 4 = IF revMask THEN ¥ Reverse mask if predecrement
val" regmask is " w,
op1 compidxmode
op2 compidxmode
;M
:M LENGTH: { ¥ len -- len }
2 -> len
op1 getop
mode: op1 2- 0<
IF
op1 false buildRegMask drop
op2 getop
op2 modesize ++> len
ELSE
op2 getop
op1 modesize ++> len
THEN
len
#tib @ -> pos ¥ Force input of a new line.
;M
;CLASS
¥ TYPE21 - UNLK
:CLASS type21 super( machinst )
:M BUILD:
op1 getOp
get: bytecode
reg: op1 or
w,
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
1
;M
;CLASS
¥ TYPE22 - ADDX, SUBX, CMPM
:CLASS type22 super( machinst )
:M BUILD: { ¥ work -- }
op1 getOp
op2 getOp
get: bytecode -> work
reg: op1 work or -> work
opFmt 6 << work or -> work
reg: op2 9 << work or -> work
mode: op1 4 =
IF
8 work or -> work
THEN
work w,
;M
:M LENGTH: { ¥ len -- len }
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
mode: op1 mode: op2 = not
IF
207 asmError
THEN
1 -> len
op1 modesize ++> len
op2 modesize ++> len
len
;M
;CLASS
:CLASS type23 super( machinst ) ¥ Pseudo-ops
:M LENGTH:
get: srcmask ¥ we use the srcmask field for the op
SELECT{
0 IS{ #tib @ -> pos }END ¥ comment
1 IS{ release: symtab }END ¥ LOC
DEFAULT{
}SELECT
0
;M
:M BUILD:
get: srcmask
SELECT{
0 IS{ #tib @ -> pos }END
1 IS{ }END
DEFAULT{
}SELECT
;M
;CLASS
:CLASS type24 super( machinst ) ¥ Call
:M LENGTH:
1 ¥ Length fixed - mrh
#tib @ -> pos
;M
:M BUILD:
nextToken drop
get: token >r here r cmove here r> AsmCall
;M
;CLASS
¥ TYPE26 - Sized instruction with single ea operand, e.g. NOT, CLR, NEG
:CLASS type26 super( machinst )
:M LENGTH:
op1 getOp
op1 get: srcMask check
1 op1 modesize +
;M
:M BUILD:
op1 getOp
get: bytecode ea: op1 or
opFmt 6 << or w,
op1 compidxmode
;M
;CLASS
¥ CLASS27 - STOP
:CLASS type27 super( machinst )
:M LENGTH:
op1 getOp
op1 get: srcMask check
2
;M
:M BUILD:
op1 getOp
get: bytecode w,
value: op1 w,
;M
;CLASS
¥ TYPE28 - PUSH and POP - synonyms for MOVE to and from the stack.
:CLASS TYPE28 super( machinst )
:M BUILD:
op1 getOp
get: bytecode dup $ 20 <
IF ( POP )
reg: op1 9 << mode: op1 7 min 6 << or
ELSE
ea: op1
THEN or
opFmt moveSize or w,
op1 compIdxMode
;M
:M LENGTH:
op1 getOp
op1 get: srcMask check
op1 modeSize 1+
;M
;CLASS
¥ TYPE29 - DC. Only numbers allowed, e.g. dc.w 99,$200
:CLASS TYPE29 super( machinst )
:M BUILD: { ¥ cnt -- }
getFormat 0 -> cnt nextToken drop
BEGIN ¥ Loop over items
get: token >num val" number is"
opFmt
NIF c,
ELSE opFmt 1 = IF w, ELSE , THEN
THEN
nextToken drop get: token " ," s=
WHILE
nextToken drop
REPEAT
dp 1 and IF 0 c, THEN
;M
:M LENGTH: { ¥ cnt -- #wds }
getFormat 0 -> cnt nextToken drop
BEGIN ¥ Loop over items
get: token >num drop 1 ++> cnt
nextToken drop get: token " ," s=
WHILE
nextToken drop
REPEAT
opFmt Bfmt = IF cnt align 2/ EXIT THEN
opFmt cnt *
;m
;CLASS
¥ ======== Floating point coprocessor classes ==========
operand K-FACTOR
: >SSPEC ¥ ( format -- sspec )
SELECT{
Bfmt is{ 6 }end
Wfmt is{ 4 }end
Lfmt is{ 0 }end
Sfmt is{ 1 }end
Dfmt is{ 5 }end
Xfmt is{ 2 }end
Pfmt is{ 3 }end
DEFAULT{
}SELECT ;
¥ FPMONADIC - normal FP monadic instructions, e.g. FNEG.
:class FPMONADIC super{ machinst }
:m BUILD: { ¥ wd0 wd1 -- }
get: bytecode -> wd0
get: dstMask -> wd1 ¥ We use the dstMask field for the
¥ opcode extension
op1 getop
wd1 $ 3A = ¥ Is it FTST?
NIF ¥ No - may be 2 operands.
nextToken drop
" ," get: token s=
IF ¥ 2-operand format
op2 getop
reg: op2
ELSE ¥ 1-operand format
reg: op1
THEN
ELSE ¥ FTST - can only have 1 operand
reg: op1
THEN
7 << or> wd1 ¥ Set dest reg field
mode: op1 FPnMode =
IF
reg: op1 10 << or> wd1
ELSE
$ 4000 or> wd1 ¥ Set r/m bit
opFmt >sspec 10 << or> wd1 ¥ Source specifier field
ea: op1 or> wd0
THEN
wd0 w, wd1 w,
op1 compIdxMode
;m
:m LENGTH:
op1 getop nextToken drop
" ," get: token s=
IF ¥ 2-operand format
op2 getop
mode: op2
ELSE
mode: op1
THEN
FPnMode <> IF 245 asmError THEN ¥ Dest must be FPn
2 op1 modesize +
;m
;class
:class FPDYADIC super{ machinst }
private
:m (BLD): { ¥ wd0 wd1 -- }
get: bytecode -> wd0
get: dstMask -> wd1 ¥ We use the dstMask field for the
¥ opcode extension
reg: op2 7 << or> wd1 ¥ Set dest reg field
mode: op1 FPnMode =
IF
reg: op1 10 << or> wd1
ELSE
$ 4000 or> wd1 ¥ Set r/m bit
opFmt >sspec 10 << or> wd1 ¥ Source specifier field
ea: op1 or> wd0
THEN
wd0 w, wd1 w,
op1 compIdxMode
;m
public
:m BUILD: op1 getop op2 getop (bld): self ;m
:m LENGTH:
op1 getop op2 getop
mode: op2 FPnMode <> IF 245 asmError THEN ¥ Dest must be FPn
2 op1 modesize +
;m
;class
:class FMOVE super{ FPdyadic }
¥ This isn't a whole lot better than MOVE!
private
:m MoveFPctlReg: { to? ¥ wd0 wd1 reg -- }
get: bytecode -> wd0
to? IF
$ 8000 -> wd1
ea: op1 or> wd0
reg: op2
ELSE
$ A000 -> wd1
ea: op2 or> wd0
reg: op1
THEN
10 + 1 swap << or> wd1
wd0 w, wd1 w,
to? IF op1 ELSE op2 THEN compIdxMode ;m
public
:m BUILD: { ¥ wd0 wd1 kfact -- }
op1 getop op2 getop
mode: op2 FPnMode =
IF (bld): super EXIT THEN ¥ If dest is FPn, same as normal
¥ dyadic op.
mode: op1 FPctlRegMode =
IF false moveFPctlReg: self EXIT THEN
mode: op2 FPctlRegMode =
IF true moveFPctlReg: self EXIT THEN
mode: op1 FPnMode <> IF 255 asmerror THEN ¥ Wrong operand type
get: bytecode -> wd0 ¥ Source is FPn
$ 6000 -> wd1 0 -> kfact
opFmt Pfmt =
IF ¥ P format. This is special!
nextToken drop
1st: token & { <> IF 203 asmerror THEN
op3 getOp
mode: op3 DnMode =
IF
reg: op3 4 << or> wd1
$ 1C00 or> wd1 ¥ Dest format field
ELSE
mode: op3 immedMode <> IF 245 asmerror THEN
value: op3 or> wd1
$ 0C00 or> wd1 ¥ Dest format field
THEN
ELSE
opFmt >sspec 10 << or> wd1 ¥ Dest format field
THEN
reg: op1 7 << or> wd1 ¥ Set source reg field
ea: op2 or> wd0
wd0 w, wd1 w,
op2 compIdxMode
;m
:m LENGTH:
op1 getop op2 getop
mode: op1 FPctlRegMode =
IF
op2 $ 71FF check
op2 modesize 2+ EXIT
THEN
mode: op2 FPctlRegMode =
IF
op1 $ 7FFF check
op1 modesize 2+ EXIT
THEN
mode: op2 FPnMode =
IF
op1 modesize 2+
ELSE
mode: op1 FPnMode <> IF 255 asmError THEN
op2 modesize 2+
THEN
;m
;class
0 value REGMASK
:class FMOVEM super{ machinst }
:m BUILD: { ¥ drFlag wd0 wd1 CRflag mode -- }
get: bytecode -> wd0
get: dstMask -> wd1
false -> CRflag 0 -> mode 0 -> regMask
op1 getOp
mode: op1 dup FPnMode = over FPctlRegMode = or
swap DnMode = or
IF ¥ Register to memory
1 -> drFlag
mode: op1 DnMode =
IF
1 -> mode
reg: op1 -> regMask
ELSE
mode: op1 FPctlRegMode = -> CRflag
op1 true buildRegMask -> regMask
THEN
op2 getOp
mode: op2 -(An)Mode <> 2 and or> mode
ea: op2
ELSE ¥ Memory to register
0 -> drFlag
nextToken drop
op2 getOp
mode: op2 DnMode =
IF
3 -> mode
reg: op2 -> regMask
ELSE
2 -> mode
op2 true buildRegMask -> regMask
mode: op2 FPctlRegMode = -> CRflag
THEN
ea: op1
THEN
( ea in stack ) or> wd0
drFlag 13 << or> wd1
mode 11 << or> wd1
CRflag
NIF
mode: op2 -(An)mode <> mode 1 and 0= and
¥ i.e. not predecrement, and static reg list.
¥ NOTE mask is reversed compared with MOVEM!
IF regMask revMask 8 >> -> regMask THEN
THEN
regMask or> wd1
wd0 w, wd1 w,
op1 compidxmode op2 compidxmode
;m
:m LENGTH:
op1 getop
mode: op1 FPnMode =
IF
op1 true buildRegMask drop
op2 getop
2 op2 modesize +
ELSE
op2 getop
2 op1 modesize +
THEN
#tib @ -> pos ¥ Force input of a new line.
;m
;class
:class FBcc super{ machinst }
:m BUILD: { ¥ wd -- }
get: bytecode -> wd
op1 getOp
op1 abs: operand dup NIF 245 asmError THEN ¥ wrong mode
here 2+ -
opFmt Wfmt =
IF wd w, 250 wordChk w,
ELSE $ 40 or> wd wd w, ,
THEN
;m
:m LENGTH:
op1 getOp
op1 get: srcMask check
opFmt Wfmt = IF 2 ELSE 3 THEN
;m
;class
:class FDBcc super{ machinst }
:m BUILD: { ¥ wd0 wd1 -- }
¥ We have the 2 opcode words combined in bytecode
¥ as AsmCodes is easier to set up that way. Now we
¥ must separate them.
get: bytecode dup -> wd0 -> wd1
$ FFE0 and> wd0 8 or> wd0
$ 1F and> wd1
op1 getOp op2 getOp
reg: op1 or> wd0
wd0 w, wd1 w,
op2 abs: operand here - 248 wordChk w,
;m
:m LENGTH:
op1 getOp
op1 get: srcMask check
op2 getOp
op2 get: dstMask check
3
;m
;class
:class FScc super{ machinst }
:m BUILD: { ¥ wd0 wd1 -- }
get: bytecode dup -> wd0 -> wd1
$ FFC0 and> wd0 $ 40 or> wd0
$ 1F and> wd1
op1 getOp ea: op1 or> wd0
wd0 w, wd1 w,
op1 compIdxMode
;m
:m LENGTH:
op1 getOp
op1 get: srcMask check
2 op1 modeSize +
;m
;class
:class FTRAPcc super{ machinst }
:m BUILD: { ¥ wd0 wd1 -- }
get: bytecode dup -> wd0 -> wd1
$ FFC0 and> wd0 $ 38 or> wd0
$ 1F and> wd1
opFmt Wfmt = opFmt Lfmt = or
IF
op1 getOp
opFmt Wfmt =
IF
2 or> wd0 wd0 w, wd1 w,
value: op1 248 wordChk w,
ELSE
3 or> wd0 wd0 w, wd1 w,
value: op1 ,
THEN
ELSE
4 or> wd0 wd0 w, wd1 w,
THEN
;m
:m LENGTH:
opFmt Wfmt = opFmt Lfmt = or
IF
op1 getOp op1 get: srcmask check
opFmt Wfmt = IF 3 ELSE 4 THEN EXIT
THEN
2
;m
;class
:class FMOVECR super{ machinst }
:m BUILD: { ¥ wd0 wd1 -- }
get: bytecode -> wd0 get: dstMask -> wd1
op1 getOp op2 getOp
value: op1 $ 7F and or> wd1
reg: op2 7 << or> wd1
wd0 w, wd1 w,
;m
:m LENGTH:
op1 getOp op2 getOp
op1 get: srcMask check
op2 $ 8000 check ¥ Must be FPn
2
;m
;class
:class FNOP super{ machinst }
:m BUILD:
get: bytecode w, get: dstMask w, ;m
:m LENGTH: 2 ;m
;class
:class FSINCOS super{ machinst }
:m BUILD: { ¥ wd0 wd1 -- }
op1 getop op3 getop nextToken drop op2 getop
get: bytecode -> wd0
get: dstMask -> wd1
reg: op2 7 << or> wd1
reg: op3 or> wd1
mode: op1 FPnMode =
IF
reg: op1 10 << or> wd1
ELSE
$ 4000 or> wd1 ¥ Set r/m bit
opFmt >sspec 10 << or> wd1 ¥ Source specifier field
ea: op1 or> wd0
THEN
wd0 w, wd1 w,
op1 compIdxMode
;m
:m LENGTH:
op1 getop op3 getop
nextToken drop
1st: token & : <> IF 203 asmerror THEN ¥ Bad operand
op2 getop
op2 $ 8000 check op3 $ 8000 check ¥ Both dests must be FPn
op1 modesize 2+
;m
;class